home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / eterm / tshell.el.z / tshell.el
Encoding:
Text File  |  1998-05-21  |  33.4 KB  |  818 lines
  1. ;;; tshell.el --- specialized term.el for running the shell.
  2.  
  3. ;; Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Per Bothner <bothner@cygnus.com>
  6. ;; Original comint version author: Olin Shivers <shivers@cs.cmu.edu>
  7. ;; Comint version maintainer: Simon Marshall <s.marshall@dcs.hull.ac.uk>
  8. ;; Keywords: processes
  9.  
  10. ;; This file is part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;;; Please send me bug reports, bug fixes, and extensions, so that I can
  29. ;;; merge them into the master source.
  30. ;;;     - Olin Shivers (shivers@cs.cmu.edu)
  31. ;;;     - Simon Marshall (s.marshall@dcs.hull.ac.uk)
  32.  
  33. ;;; This file defines a a shell-in-a-buffer package (shell mode) built
  34. ;;; on top of term mode.  This is actually cmushell with things
  35. ;;; renamed to replace its counterpart in Emacs 18.  cmushell is more
  36. ;;; featureful, robust, and uniform than the Emacs 18 version.
  37.  
  38. ;;; Since this mode is built on top of the general command-interpreter-in-
  39. ;;; a-buffer mode (term mode), it shares a common base functionality, 
  40. ;;; and a common set of bindings, with all modes derived from term mode.
  41. ;;; This makes these modes easier to use.
  42.  
  43. ;;; For documentation on the functionality provided by term mode, and
  44. ;;; the hooks available for customising it, see the file term.el.
  45. ;;; For further information on shell mode, see the comments below.
  46.  
  47. ;;; Needs fixin:
  48. ;;; When sending text from a source file to a subprocess, the process-mark can 
  49. ;;; move off the window, so you can lose sight of the process interactions.
  50. ;;; Maybe I should ensure the process mark is in the window when I send
  51. ;;; text to the process? Switch selectable?
  52.  
  53. ;; YOUR .EMACS FILE
  54. ;;=============================================================================
  55. ;; Some suggestions for your .emacs file.
  56. ;;
  57. ;; ;; Define C-c t to run my favorite command in shell mode:
  58. ;; (setq tshell-mode-hook
  59. ;;       '((lambda () 
  60. ;;           (define-key tshell-mode-map "\C-ct" 'favorite-cmd))))
  61.  
  62.  
  63. ;;; Brief Command Documentation:
  64. ;;;============================================================================
  65. ;;; Term Mode Commands: (common to tshell and all term-derived modes)
  66. ;;;
  67. ;;; m-p        term-previous-input            Cycle backwards in input history
  68. ;;; m-n        term-next-input                  Cycle forwards
  69. ;;; m-r     term-previous-matching-input  Previous input matching a regexp
  70. ;;; m-R     term-previous-matching-input-from-input -"- matching input
  71. ;;; m-s     term-next-matching-input      Next input that matches
  72. ;;; m-S     term-next-matching-input-from-input     -"- matching input
  73. ;;; m-c-l   term-show-output            Show last batch of process output
  74. ;;; return  term-send-input
  75. ;;; c-c c-a term-bol                      Beginning of line; skip prompt
  76. ;;; c-d        term-delchar-or-maybe-eof        Delete char unless at end of buff.
  77. ;;; c-c c-u term-kill-input                ^u
  78. ;;; c-c c-w backward-kill-word            ^w
  79. ;;; c-c c-c term-interrupt-subjob         ^c
  80. ;;; c-c c-z term-stop-subjob                ^z
  81. ;;; c-c c-\ term-quit-subjob                ^\
  82. ;;; c-c c-o term-kill-output            Delete last batch of process output
  83. ;;; c-c c-r term-show-output            Show last batch of process output
  84. ;;; c-c c-h term-dynamic-list-input-ring    List input history
  85. ;;;         term-send-invisible             Read line w/o echo & send to proc
  86. ;;;         term-continue-subjob        Useful if you accidentally suspend
  87. ;;;                            top-level job
  88. ;;; term-mode-hook is the term mode hook.
  89.  
  90. ;;; Tshell Mode Commands:
  91. ;;;         tshell                Fires up the shell process
  92. ;;; tab     term-dynamic-complete        Complete filename/command/history
  93. ;;; m-?     term-dynamic-list-filename-completions List completions in help buffer
  94. ;;; m-c-f   tshell-forward-command           Forward a shell command
  95. ;;; m-c-b   tshell-backward-command          Backward a shell command
  96. ;;;         dirs                    Resync the buffer's dir stack
  97. ;;;         dirtrack-toggle                 Turn dir tracking on/off
  98. ;;;         tshell-strip-ctrl-m              Remove trailing ^Ms from output
  99. ;;;
  100. ;;; The tshell mode hook is tshell-mode-hook
  101. ;;; term-prompt-regexp is initialised to tshell-prompt-pattern, for backwards
  102. ;;; compatibility.
  103.  
  104. ;;; Read the rest of this file for more information.
  105.  
  106. ;;; SHELL.EL COMPATIBILITY
  107. ;;; Notes from when this was called cmushell, and was not the standard emacs
  108. ;;; shell package.
  109. ;;;============================================================================
  110. ;;; In brief: this package should have no trouble coexisting with shell.el.
  111. ;;; 
  112. ;;; Most customising variables -- e.g., explicit-shell-file-name -- are the
  113. ;;; same, so the users shouldn't have much trouble. Hooks have different
  114. ;;; names, however, so you can customise tshell mode differently from cmushell
  115. ;;; mode. You basically just have to remember to type M-x cmushell instead of
  116. ;;; M-x shell.
  117. ;;; 
  118. ;;; It would be nice if this file was completely plug-compatible with the old
  119. ;;; shell package -- if you could just name this file shell.el, and have it
  120. ;;; transparently replace the old one. But you can't.  Several other packages
  121. ;;; (tex-mode, background, dbx, gdb, kermit, monkey, prolog, telnet) are also
  122. ;;; clients of shell mode. These packages assume detailed knowledge of shell
  123. ;;; mode internals in ways that are incompatible with cmushell mode (mostly
  124. ;;; because of cmushell mode's greater functionality).  So, unless we are
  125. ;;; willing to port all of these packages, we can't have this file be a
  126. ;;; complete replacement for shell.el -- that is, we can't name this file
  127. ;;; shell.el, and its main entry point (shell), because dbx.el will break
  128. ;;; when it loads it in and tries to use it.
  129. ;;; 
  130. ;;; There are two ways to fix this. One: rewrite these other modes to use the
  131. ;;; new package. This is a win, but can't be assumed. The other, backwards
  132. ;;; compatible route, is to make this package non-conflict with shell.el, so
  133. ;;; both files can be loaded in at the same time. And *that* is why some
  134. ;;; functions and variables have different names: (cmushell),
  135. ;;; cmushell-mode-map, that sort of thing. All the names have been carefully
  136. ;;; chosen so that shell.el and cmushell.el won't tromp on each other.
  137.  
  138. ;;; Customization and Buffer Variables
  139. ;;; ===========================================================================
  140. ;;; 
  141.  
  142. ;;; Code:
  143.  
  144. (require 'term)
  145.  
  146. ;;;###autoload
  147. (defvar tshell-prompt-pattern "^[^#$%>\n]*[#$%>] *"
  148.   "Regexp to match prompts in the inferior shell.
  149. Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well.
  150. This variable is used to initialise `term-prompt-regexp' in the 
  151. shell buffer.
  152.  
  153. The pattern should probably not match more than one line.  If it does,
  154. tshell-mode may become confused trying to distinguish prompt from input
  155. on lines which don't start with a prompt.
  156.  
  157. This is a fine thing to set in your `.emacs' file.")
  158.  
  159. (defvar tshell-completion-fignore nil
  160.   "*List of suffixes to be disregarded during file/command completion.
  161. This variable is used to initialize `term-completion-fignore' in the shell
  162. buffer.  The default is nil, for compatibility with most shells.
  163. Some people like (\"~\" \"#\" \"%\").
  164.  
  165. This is a fine thing to set in your `.emacs' file.")  
  166.  
  167. (defvar tshell-delimiter-argument-list '(?\| ?& ?< ?> ?\( ?\) ?\;)
  168.   "List of characters to recognise as separate arguments.
  169. This variable is used to initialize `term-delimiter-argument-list' in the
  170. shell buffer.  The default is (?\\| ?& ?< ?> ?\\( ?\\) ?\\;).
  171.  
  172. This is a fine thing to set in your `.emacs' file.")
  173.  
  174. (defvar tshell-dynamic-complete-functions
  175.   '(term-replace-by-expanded-history
  176.     tshell-dynamic-complete-environment-variable
  177.     tshell-dynamic-complete-command
  178.     tshell-replace-by-expanded-directory
  179.     term-dynamic-complete-filename)
  180.   "List of functions called to perform completion.
  181. This variable is used to initialise `term-dynamic-complete-functions' in the
  182. shell buffer.
  183.  
  184. This is a fine thing to set in your `.emacs' file.")
  185.  
  186. (defvar shell-command-regexp "[^;&|\n]+"
  187.   "*Regexp to match a single command within a pipeline.
  188. This is used for directory tracking and does not do a perfect job.")
  189.  
  190. (defvar shell-completion-execonly t
  191.   "*If non-nil, use executable files only for completion candidates.
  192. This mirrors the optional behavior of tcsh.
  193.  
  194. Detecting executability of files may slow command completion considerably.")
  195.  
  196. (defvar shell-popd-regexp "popd"
  197.   "*Regexp to match subshell commands equivalent to popd.")
  198.  
  199. (defvar shell-pushd-regexp "pushd"
  200.   "*Regexp to match subshell commands equivalent to pushd.")
  201.  
  202. (defvar shell-pushd-tohome nil
  203.   "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd).
  204. This mirrors the optional behavior of tcsh.")
  205.  
  206. (defvar shell-pushd-dextract nil
  207.   "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top.
  208. This mirrors the optional behavior of tcsh.")
  209.  
  210. (defvar shell-pushd-dunique nil
  211.   "*If non-nil, make pushd only add unique directories to the stack.
  212. This mirrors the optional behavior of tcsh.")
  213.  
  214. (defvar shell-cd-regexp "cd"
  215.   "*Regexp to match subshell commands equivalent to cd.")
  216.  
  217. ;; explicit-shell-file-name nil is in term.el.
  218.  
  219. (defvar explicit-csh-args
  220.   (if (eq system-type 'hpux)
  221.       ;; -T persuades HP's csh not to think it is smarter
  222.       ;; than us about what terminal modes to use.
  223.       '("-i" "-T")
  224.     '("-i"))
  225.   "*Args passed to inferior shell by M-x tshell, if the shell is csh.
  226. Value is a list of strings, which may be nil.")
  227.  
  228. (defvar tshell-input-autoexpand 'history
  229.   "*If non-nil, expand input command history references on completion.
  230. This mirrors the optional behavior of tcsh (its autoexpand and histlit).
  231.  
  232. If the value is `input', then the expansion is seen on input.
  233. If the value is `history', then the expansion is only when inserting
  234. into the buffer's input ring.  See also `term-magic-space' and
  235. `term-dynamic-complete'.
  236.  
  237. This variable supplies a default for `term-input-autoexpand',
  238. for Tshell mode only.")
  239.  
  240. (defvar tshell-dirstack nil
  241.   "List of directories saved by pushd in this buffer's shell.
  242. Thus, this does not include the shell's current directory.")
  243.  
  244. (defvar tshell-dirtrackp t
  245.   "Non-nil in a shell buffer means directory tracking is enabled.")
  246.  
  247. (defvar tshell-last-dir nil
  248.   "Keep track of last directory for ksh `cd -' command.")
  249.  
  250. (defvar tshell-dirstack-query nil
  251.   "Command used by `tshell-resync-dir' to query the shell.")
  252.  
  253. (defvar tshell-mode-map nil)
  254. (cond ((not tshell-mode-map)
  255.        (setq tshell-mode-map (copy-keymap term-mode-map))
  256.        (define-key tshell-mode-map "\C-c\C-f" 'tshell-forward-command)
  257.        (define-key tshell-mode-map "\C-c\C-b" 'tshell-backward-command)
  258.        (define-key tshell-mode-map "\t" 'term-dynamic-complete)
  259.        (define-key tshell-mode-map "\M-?"
  260.      'term-dynamic-list-filename-completions)
  261. ;;; XEmacs change [JTL]: We don't have define-key-after   
  262. ;;;                 (and we don't need it ...)
  263. ;;;       (define-key-after (lookup-key tshell-mode-map [menu-bar completion])
  264. ;;;     [complete-env-variable] '("Complete Env. Variable Name" .
  265. ;;;                   tshell-dynamic-complete-environment-variable)
  266. ;;;        'complete-file)
  267. ;;;      (define-key-after (lookup-key tshell-mode-map [menu-bar completion])
  268. ;;;        [expand-directory] '("Expand Directory Reference" .
  269. ;;;                 tshell-replace-by-expanded-directory)
  270. ;;;        'complete-expand)
  271.        ))
  272.  
  273. (defvar tshell-mode-hook '()
  274.   "*Hook for customising Tshell mode.")
  275.  
  276.  
  277. ;;; Basic Procedures
  278. ;;; ===========================================================================
  279. ;;;
  280.  
  281. (defun tshell-mode ()
  282.   "Major mode for interacting with an inferior shell.
  283. Return after the end of the process' output sends the text from the 
  284.     end of process to the end of the current line.
  285. Return before end of process output copies the current line (except
  286.     for the prompt) to the end of the buffer and sends it.
  287. M-x term-send-invisible reads a line of text without echoing it,
  288.     and sends it to the shell.  This is useful for entering passwords.
  289.  
  290. If you accidentally suspend your process, use \\[term-continue-subjob]
  291. to continue it.
  292.  
  293. cd, pushd and popd commands given to the shell are watched by Emacs to keep
  294. this buffer's default directory the same as the shell's working directory.
  295. M-x dirs queries the shell and resyncs Emacs' idea of what the current 
  296.     directory stack is.
  297. M-x dirtrack-toggle turns directory tracking on and off.
  298.  
  299. \\{tshell-mode-map}
  300. Customization: Entry to this mode runs the hooks on `term-mode-hook' and
  301. `tshell-mode-hook' (in that order).  Before each input, the hooks on
  302. `term-input-filter-functions' are run.
  303.  
  304. Variables `shell-cd-regexp', `shell-pushd-regexp' and `shell-popd-regexp'
  305. are used to match their respective commands, while `shell-pushd-tohome',
  306. `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the
  307. relevant command.
  308.  
  309. Variables `term-completion-autolist', `term-completion-addsuffix',
  310. `term-completion-recexact' and `term-completion-fignore' control the
  311. behavior of file name, command name and variable name completion.  Variable
  312. `shell-completion-execonly' controls the behavior of command name completion.
  313. Variable `tshell-completion-fignore' is used to initialise the value of
  314. `term-completion-fignore'.
  315.  
  316. Variables `term-input-ring-file-name' and `term-input-autoexpand' control
  317. the initialisation of the input ring history, and history expansion.
  318.  
  319. Variables `term-output-filter-functions', a hook, and
  320. `term-scroll-to-bottom-on-input' and `term-scroll-to-bottom-on-output'
  321. control whether input and output cause the window to scroll to the end of the
  322. buffer."
  323.   (interactive)
  324.   (term-mode)
  325.   (setq major-mode 'tshell-mode)
  326.   (setq mode-name "Shell")
  327.   (use-local-map tshell-mode-map)
  328.   (setq term-prompt-regexp tshell-prompt-pattern)
  329.   (setq term-completion-fignore tshell-completion-fignore)
  330.   (setq term-delimiter-argument-list tshell-delimiter-argument-list)
  331.   (setq term-dynamic-complete-functions tshell-dynamic-complete-functions)
  332.   (make-local-variable 'paragraph-start)
  333.   (setq paragraph-start term-prompt-regexp)
  334.   (make-local-variable 'tshell-dirstack)
  335.   (setq tshell-dirstack nil)
  336.   (setq tshell-last-dir nil)
  337.   (make-local-variable 'tshell-dirtrackp)
  338.   (setq tshell-dirtrackp t)
  339.   (add-hook 'term-input-filter-functions 'tshell-directory-tracker)
  340.   (setq term-input-autoexpand tshell-input-autoexpand)
  341.   ;; shell-dependent assignments.
  342.   (let ((shell (file-name-nondirectory (car
  343.          (process-command (get-buffer-process (current-buffer)))))))
  344.     (setq term-input-ring-file-name
  345.       (or (getenv "HISTFILE")
  346.           (cond ((string-equal shell "bash") "~/.bash_history")
  347.             ((string-equal shell "ksh") "~/.sh_history")
  348.             (t "~/.history"))))
  349.     (if (equal term-input-ring-file-name "/dev/null")
  350.     (setq term-input-ring-file-name nil))
  351.     (setq tshell-dirstack-query
  352.       (if (string-match "^k?sh$" shell) "pwd" "dirs")))
  353.   (run-hooks 'tshell-mode-hook)
  354.   (term-read-input-ring t))
  355.  
  356. ;;;###autoload
  357. (defun tshell ()
  358.   "Run an inferior shell, with I/O through buffer *shell*.
  359. If buffer exists but shell process is not running, make new shell.
  360. If buffer exists and shell process is running, just switch to buffer `*shell*'.
  361. Program used comes from variable `explicit-shell-file-name',
  362.  or (if that is nil) from the ESHELL environment variable,
  363.  or else from SHELL if there is no ESHELL.
  364. If a file `~/.emacs_SHELLNAME' exists, it is given as initial input
  365.  (Note that this may lose due to a timing error if the shell
  366.   discards input when it starts up.)
  367. The buffer is put in Tshell mode, giving commands for sending input
  368. and controlling the subjobs of the shell.  See `tshell-mode'.
  369. See also the variable `tshell-prompt-pattern'.
  370.  
  371. The shell file name (sans directories) is used to make a symbol name
  372. such as `explicit-csh-args'.  If that symbol is a variable,
  373. its value is used as a list of arguments when invoking the shell.
  374. Otherwise, one argument `-i' is passed to the shell.
  375.  
  376. \(Type \\[describe-mode] in the shell buffer for a list of commands.)"
  377.   (interactive)
  378.   (if (not (term-check-proc "*shell*"))
  379.       (let* ((prog (or explicit-shell-file-name
  380.                (getenv "ESHELL")
  381.                (getenv "SHELL")
  382.                "/bin/sh"))             
  383.          (name (file-name-nondirectory prog))
  384.          (startfile (concat "~/.emacs_" name))
  385.          (xargs-name (intern-soft (concat "explicit-" name "-args"))))
  386.     (set-buffer (apply 'make-term "shell" prog
  387.                (if (file-exists-p startfile) startfile)
  388.                (if (and xargs-name (boundp xargs-name))
  389.                    (symbol-value xargs-name)
  390.                  '("-i"))))
  391.     (tshell-mode)))
  392.   (switch-to-buffer "*shell*"))
  393.  
  394. ;;; Directory tracking
  395. ;;; ===========================================================================
  396. ;;; This code provides the tshell mode input sentinel
  397. ;;;     TSHELL-DIRECTORY-TRACKER
  398. ;;; that tracks cd, pushd, and popd commands issued to the tshell, and
  399. ;;; changes the current directory of the tshell buffer accordingly.
  400. ;;;
  401. ;;; A better mechanism is now available:
  402. ;;; The standard term process filter supports a special escape command
  403. ;;;     \032 / <cwd> \n
  404. ;;; that the inferior can use to tell emacs what the current working
  405. ;;; directory is.
  406. ;;; All the inferior has to do is something like:
  407. ;;;     printf("\032/%s\n", PWD);
  408. ;;; Most modern shells can be programmed to emit this string easily.
  409. ;;; Hopefully, bash (at least) will be modified to do this automatically.
  410. ;;;
  411. ;;; So all this horrible directory-tracking machinary is now obsolete,
  412. ;;; but is kept at least until the standard GNU shells are modified
  413. ;;;
  414. ;;; This is basically a fragile hack, although it's more accurate than
  415. ;;; the version in Emacs 18's shell.el. It has the following failings:
  416. ;;; 1. It doesn't know about the cdpath shell variable.
  417. ;;; 2. It cannot infallibly deal with command sequences, though it does well
  418. ;;;    with these and with ignoring commands forked in another shell with ()s.
  419. ;;; 3. More generally, any complex command is going to throw it. Otherwise,
  420. ;;;    you'd have to build an entire shell interpreter in emacs lisp.  Failing
  421. ;;;    that, there's no way to catch shell commands where cd's are buried
  422. ;;;    inside conditional expressions, aliases, and so forth.
  423. ;;;
  424. ;;; The whole approach is a crock. Shell aliases mess it up. File sourcing
  425. ;;; messes it up. You run other processes under the shell; these each have
  426. ;;; separate working directories, and some have commands for manipulating
  427. ;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have
  428. ;;; commands that do *not* affect the current w.d. at all, but look like they
  429. ;;; do (e.g., the cd command in ftp).  In shells that allow you job
  430. ;;; control, you can switch between jobs, all having different w.d.'s. So
  431. ;;; simply saying %3 can shift your w.d..
  432. ;;;
  433. ;;; The solution is to relax, not stress out about it, and settle for
  434. ;;; a hack that works pretty well in typical circumstances. Remember
  435. ;;; that a half-assed solution is more in keeping with the spirit of Unix, 
  436. ;;; anyway. Blech.
  437.  
  438. (defun tshell-directory-tracker (str)
  439.   "Tracks cd, pushd and popd commands issued to the shell.
  440. This function is called on each input passed to the shell.
  441. It watches for cd, pushd and popd commands and sets the buffer's
  442. default directory to track these commands.
  443.  
  444. You may toggle this tracking on and off with M-x dirtrack-toggle.
  445. If emacs gets confused, you can resync with the shell with M-x dirs.
  446.  
  447. See variables `shell-cd-regexp', `shell-pushd-regexp', and `shell-popd-regexp',
  448. while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique'
  449. control the behavior of the relevant command.
  450.  
  451. Environment variables are expanded, see function `substitute-in-file-name'."
  452.   (if tshell-dirtrackp
  453.       ;; We fail gracefully if we think the command will fail in the shell.
  454.       (condition-case chdir-failure
  455.       (let ((start (progn (string-match "^[;\\s ]*" str) ; skip whitespace
  456.                   (match-end 0)))
  457.         end cmd arg1)
  458.         (while (string-match shell-command-regexp str start)
  459.           (setq end (match-end 0)
  460.             cmd (term-arguments (substring str start end) 0 0)
  461.             arg1 (term-arguments (substring str start end) 1 1))
  462.           (cond ((eq (string-match shell-popd-regexp cmd) 0)
  463.              (tshell-process-popd (substitute-in-file-name arg1)))
  464.             ((eq (string-match shell-pushd-regexp cmd) 0)
  465.              (tshell-process-pushd (substitute-in-file-name arg1)))
  466.             ((eq (string-match shell-cd-regexp cmd) 0)
  467.              (tshell-process-cd (substitute-in-file-name arg1))))
  468.           (setq start (progn (string-match "[;\\s ]*" str end) ; skip again
  469.                  (match-end 0)))))
  470.     (error "Couldn't cd"))))
  471.  
  472. ;;; popd [+n]
  473. (defun tshell-process-popd (arg)
  474.   (let ((num (or (tshell-extract-num arg) 0)))
  475.     (cond ((and num (= num 0) tshell-dirstack)
  476.        (cd (car tshell-dirstack))
  477.        (setq tshell-dirstack (cdr tshell-dirstack))
  478.        (tshell-dirstack-message))
  479.       ((and num (> num 0) (<= num (length tshell-dirstack)))
  480.        (let* ((ds (cons nil tshell-dirstack))
  481.           (cell (nthcdr (1- num) ds)))
  482.          (rplacd cell (cdr (cdr cell)))
  483.          (setq tshell-dirstack (cdr ds))
  484.          (tshell-dirstack-message)))
  485.       (t
  486.        (error "Couldn't popd")))))
  487.  
  488. ;; Return DIR prefixed with term-file-name-prefix as appropriate.
  489. (defun tshell-prefixed-directory-name (dir)
  490.   (if (= (length term-file-name-prefix) 0)
  491.       dir
  492.     (if (file-name-absolute-p dir)
  493.     ;; The name is absolute, so prepend the prefix.
  494.     (concat term-file-name-prefix dir)
  495.       ;; For a relative name we assume default-directory already has the prefix.
  496.       (expand-file-name dir))))
  497.  
  498. ;;; cd [dir]
  499. (defun tshell-process-cd (arg)
  500.   (let ((new-dir (cond ((zerop (length arg)) (concat term-file-name-prefix
  501.                              "~"))
  502.                ((string-equal "-" arg) tshell-last-dir)
  503.                (t (tshell-prefixed-directory-name arg)))))
  504.     (setq tshell-last-dir default-directory)
  505.     (cd new-dir)
  506.     (tshell-dirstack-message)))
  507.  
  508. ;;; pushd [+n | dir]
  509. (defun tshell-process-pushd (arg)
  510.   (let ((num (tshell-extract-num arg)))
  511.     (cond ((zerop (length arg))
  512.        ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome
  513.        (cond (shell-pushd-tohome
  514.           (shell-process-pushd (concat term-file-name-prefix "~")))
  515.          (tshell-dirstack
  516.           (let ((old default-directory))
  517.             (cd (car tshell-dirstack))
  518.             (setq tshell-dirstack
  519.               (cons old (cdr tshell-dirstack)))
  520.             (tshell-dirstack-message)))
  521.          (t
  522.           (message "Directory stack empty."))))
  523.       ((numberp num)
  524.        ;; pushd +n
  525.        (cond ((> num (length tshell-dirstack))
  526.           (message "Directory stack not that deep."))
  527.          ((= num 0)
  528.           (error (message "Couldn't cd.")))
  529.          (shell-pushd-dextract
  530.           (let ((dir (nth (1- num) tshell-dirstack)))
  531.             (tshell-process-popd arg)
  532.             (tshell-process-pushd default-directory)
  533.             (cd dir)
  534.             (tshell-dirstack-message)))
  535.          (t
  536.           (let* ((ds (cons default-directory tshell-dirstack))
  537.              (dslen (length ds))
  538.              (front (nthcdr num ds))
  539.              (back (reverse (nthcdr (- dslen num) (reverse ds))))
  540.              (new-ds (append front back)))
  541.             (cd (car new-ds))
  542.             (setq tshell-dirstack (cdr new-ds))
  543.             (tshell-dirstack-message)))))
  544.       (t
  545.        ;; pushd <dir>
  546.        (let ((old-wd default-directory))
  547.          (cd (tshell-prefixed-directory-name arg))
  548.          (if (or (null shell-pushd-dunique)
  549.              (not (member old-wd tshell-dirstack)))
  550.          (setq tshell-dirstack (cons old-wd tshell-dirstack)))
  551.          (tshell-dirstack-message))))))
  552.  
  553. ;; If STR is of the form +n, for n>0, return n. Otherwise, nil.
  554. (defun tshell-extract-num (str)
  555.   (and (string-match "^\\+[1-9][0-9]*$" str)
  556.        (string-to-int str)))
  557.  
  558.  
  559. (defun tshell-dirtrack-toggle ()
  560.   "Turn directory tracking on and off in a shell buffer."
  561.   (interactive)
  562.   (setq tshell-dirtrackp (not tshell-dirtrackp))
  563.   (message "Directory tracking %s" (if tshell-dirtrackp "ON" "OFF")))
  564.  
  565. ;;; For your typing convenience:
  566. (defalias 'dirtrack-toggle 'tshell-dirtrack-toggle)
  567.  
  568.  
  569. (defun tshell-resync-dirs ()
  570.   "Resync the buffer's idea of the current directory stack.
  571. This command queries the shell with the command bound to 
  572. `tshell-dirstack-query' (default \"dirs\"), reads the next
  573. line output and parses it to form the new directory stack.
  574. DON'T issue this command unless the buffer is at a shell prompt.
  575. Also, note that if some other subprocess decides to do output
  576. immediately after the query, its output will be taken as the
  577. new directory stack -- you lose. If this happens, just do the
  578. command again."
  579.   (interactive)
  580.   (let* ((proc (get-buffer-process (current-buffer)))
  581.      (pmark (process-mark proc)))
  582.     (goto-char pmark)
  583.     (insert tshell-dirstack-query) (insert "\n")
  584.     (sit-for 0) ; force redisplay
  585.     (term-send-string proc tshell-dirstack-query) 
  586.     (term-send-string proc "\n")
  587.     (set-marker pmark (point))
  588.     (let ((pt (point))) ; wait for 1 line
  589.       ;; This extra newline prevents the user's pending input from spoofing us.
  590.       (insert "\n") (backward-char 1)
  591.       (while (not (looking-at ".+\n"))
  592.     (accept-process-output proc)
  593.     (goto-char pt)))
  594.     (goto-char pmark) (delete-char 1) ; remove the extra newline
  595.     ;; That's the dirlist. grab it & parse it.
  596.     (let* ((dl (buffer-substring (match-beginning 0) (1- (match-end 0))))
  597.        (dl-len (length dl))
  598.        (ds '())            ; new dir stack
  599.        (i 0))
  600.       (while (< i dl-len)
  601.     ;; regexp = optional whitespace, (non-whitespace), optional whitespace
  602.     (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
  603.     (setq ds (cons (concat term-file-name-prefix
  604.                    (substring dl (match-beginning 1)
  605.                       (match-end 1)))
  606.                ds))
  607.     (setq i (match-end 0)))
  608.       (let ((ds (nreverse ds)))
  609.     (condition-case nil
  610.         (progn (cd (car ds))
  611.            (setq tshell-dirstack (cdr ds))
  612.            (tshell-dirstack-message))
  613.       (error (message "Couldn't cd.")))))))
  614.  
  615. ;;; For your typing convenience:
  616. (defalias 'dirs 'tshell-resync-dirs)
  617.  
  618.  
  619. ;;; Show the current dirstack on the message line.
  620. ;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo".
  621. ;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".)
  622. ;;; All the commands that mung the buffer's dirstack finish by calling
  623. ;;; this guy.
  624. (defun tshell-dirstack-message ()
  625.   (let* ((msg "")
  626.      (ds (cons default-directory tshell-dirstack))
  627.      (home (expand-file-name (concat term-file-name-prefix "~/")))
  628.      (homelen (length home)))
  629.     (while ds
  630.       (let ((dir (car ds)))
  631.     (and (>= (length dir) homelen) (string= home (substring dir 0 homelen))
  632.         (setq dir (concat "~/" (substring dir homelen))))
  633.     ;; Strip off term-file-name-prefix if present.
  634.     (and term-file-name-prefix
  635.          (>= (length dir) (length term-file-name-prefix))
  636.          (string= term-file-name-prefix
  637.               (substring dir 0 (length term-file-name-prefix)))
  638.          (setq dir (substring dir (length term-file-name-prefix)))
  639.          (setcar ds dir))
  640.     (setq msg (concat msg (directory-file-name dir) " "))
  641.     (setq ds (cdr ds))))
  642.     (message msg)))
  643.  
  644. (defun tshell-forward-command (&optional arg)
  645.   "Move forward across ARG shell command(s).  Does not cross lines.
  646. See `shell-command-regexp'."
  647.   (interactive "p")
  648.   (let ((limit (save-excursion (end-of-line nil) (point))))
  649.     (if (re-search-forward (concat shell-command-regexp "\\([;&|][\t ]*\\)+")
  650.                limit 'move arg)
  651.     (skip-syntax-backward " "))))
  652.  
  653.  
  654. (defun tshell-backward-command (&optional arg)
  655.   "Move backward across ARG shell command(s).  Does not cross lines.
  656. See `shell-command-regexp'."
  657.   (interactive "p")
  658.   (let ((limit (save-excursion (term-bol nil) (point))))
  659.     (if (> limit (point))
  660.     (save-excursion (beginning-of-line) (setq limit (point))))
  661.     (skip-syntax-backward " " limit)
  662.     (if (re-search-backward
  663.      (format "[;&|]+[\t ]*\\(%s\\)" shell-command-regexp) limit 'move arg)
  664.     (progn (goto-char (match-beginning 1))
  665.            (skip-chars-forward ";&|")))))
  666.  
  667.  
  668. (defun tshell-dynamic-complete-command ()
  669.   "Dynamically complete the command at point.
  670. This function is similar to `term-dynamic-complete-filename', except that it
  671. searches `exec-path' (minus the trailing emacs library path) for completion
  672. candidates.  Note that this may not be the same as the shell's idea of the
  673. path.
  674.  
  675. Completion is dependent on the value of `shell-completion-execonly', plus
  676. those that effect file completion.  See `tshell-dynamic-complete-as-command'.
  677.  
  678. Returns t if successful."
  679.   (interactive)
  680.   (let ((filename (term-match-partial-filename)))
  681.     (if (and filename
  682.          (save-match-data (not (string-match "[~/]" filename)))
  683.          (eq (match-beginning 0)
  684.          (save-excursion (tshell-backward-command 1) (point))))
  685.     (prog2 (message "Completing command name...")
  686.         (tshell-dynamic-complete-as-command)))))
  687.  
  688.  
  689. (defun tshell-dynamic-complete-as-command ()
  690.   "Dynamically complete at point as a command.
  691. See `tshell-dynamic-complete-filename'.  Returns t if successful."
  692.   (let* ((filename (or (term-match-partial-filename) ""))
  693.      (pathnondir (file-name-nondirectory filename))
  694.      (paths (cdr (reverse exec-path)))
  695.      (cwd (file-name-as-directory (expand-file-name default-directory)))
  696.      (ignored-extensions
  697.       (and term-completion-fignore
  698.            (mapconcat (function (lambda (x) (concat (regexp-quote x) "$")))
  699.               term-completion-fignore "\\|")))
  700.      (path "") (comps-in-path ()) (file "") (filepath "") (completions ()))
  701.     ;; Go thru each path in the search path, finding completions.
  702.     (while paths
  703.       (setq path (file-name-as-directory (term-directory (or (car paths) ".")))
  704.         comps-in-path (and (file-accessible-directory-p path)
  705.                    (file-name-all-completions pathnondir path)))
  706.       ;; Go thru each completion found, to see whether it should be used.
  707.       (while comps-in-path
  708.     (setq file (car comps-in-path)
  709.           filepath (concat path file))
  710.     (if (and (not (member file completions))
  711.          (not (and ignored-extensions
  712.                (string-match ignored-extensions file)))
  713.          (or (string-equal path cwd)
  714.              (not (file-directory-p filepath)))
  715.          (or (null shell-completion-execonly)
  716.              (file-executable-p filepath)))
  717.         (setq completions (cons file completions)))
  718.     (setq comps-in-path (cdr comps-in-path)))
  719.       (setq paths (cdr paths)))
  720.     ;; OK, we've got a list of completions.
  721.     (let ((success (let ((term-completion-addsuffix nil))
  722.              (term-dynamic-simple-complete pathnondir completions))))
  723.       (if (and (memq success '(sole shortest)) term-completion-addsuffix
  724.            (not (file-directory-p (term-match-partial-filename))))
  725.       (insert " "))
  726.       success)))
  727.  
  728.  
  729. (defun tshell-match-partial-variable ()
  730.   "Return the variable at point, or nil if non is found."
  731.   (save-excursion
  732.     (let ((limit (point)))
  733.       (if (re-search-backward "[^A-Za-z0-9_{}]" nil 'move)
  734.       (or (looking-at "\\$") (forward-char 1)))
  735.       ;; Anchor the search forwards.
  736.       (if (or (eolp) (looking-at "[^A-Za-z0-9_{}$]"))
  737.       nil
  738.     (re-search-forward "\\$?{?[A-Za-z0-9_]*}?" limit)
  739.     (buffer-substring (match-beginning 0) (match-end 0))))))
  740.  
  741.  
  742. (defun tshell-dynamic-complete-environment-variable ()
  743.   "Dynamically complete the environment variable at point.
  744. Completes if after a variable, i.e., if it starts with a \"$\".
  745. See `tshell-dynamic-complete-as-environment-variable'.
  746.  
  747. This function is similar to `term-dynamic-complete-filename', except that it
  748. searches `process-environment' for completion candidates.  Note that this may
  749. not be the same as the interpreter's idea of variable names.  The main problem
  750. with this type of completion is that `process-environment' is the environment
  751. which Emacs started with.  Emacs does not track changes to the environment made
  752. by the interpreter.  Perhaps it would be more accurate if this function was
  753. called `tshell-dynamic-complete-process-environment-variable'.
  754.  
  755. Returns non-nil if successful."
  756.   (interactive)
  757.   (let ((variable (tshell-match-partial-variable)))
  758.     (if (and variable (string-match "^\\$" variable))
  759.     (prog2 (message "Completing variable name...")
  760.         (tshell-dynamic-complete-as-environment-variable)))))
  761.  
  762.  
  763. (defun tshell-dynamic-complete-as-environment-variable ()
  764.   "Dynamically complete at point as an environment variable.
  765. Used by `tshell-dynamic-complete-environment-variable'.
  766. Uses `term-dynamic-simple-complete'."
  767.   (let* ((var (or (tshell-match-partial-variable) ""))
  768.      (variable (substring var (or (string-match "[^$({]\\|$" var) 0)))
  769.      (variables (mapcar (function (lambda (x)
  770.                     (substring x 0 (string-match "=" x))))
  771.                 process-environment))
  772.      (addsuffix term-completion-addsuffix)
  773.      (term-completion-addsuffix nil)
  774.      (success (term-dynamic-simple-complete variable variables)))
  775.     (if (memq success '(sole shortest))
  776.     (let* ((var (tshell-match-partial-variable))
  777.            (variable (substring var (string-match "[^$({]" var)))
  778.            (protection (cond ((string-match "{" var) "}")
  779.                  ((string-match "(" var) ")")
  780.                  (t "")))
  781.            (suffix (cond ((null addsuffix) "")
  782.                  ((file-directory-p
  783.                    (term-directory (getenv variable))) "/")
  784.                  (t " "))))
  785.       (insert protection suffix)))
  786.     success))
  787.  
  788.  
  789. (defun tshell-replace-by-expanded-directory ()
  790.   "Expand directory stack reference before point.
  791. Directory stack references are of the form \"=digit\" or \"=-\".
  792. See `default-directory' and `tshell-dirstack'.
  793.  
  794. Returns t if successful."
  795.   (interactive)
  796.   (if (term-match-partial-filename)
  797.       (save-excursion
  798.     (goto-char (match-beginning 0))
  799.     (let ((stack (cons default-directory tshell-dirstack))
  800.           (index (cond ((looking-at "=-/?")
  801.                 (length tshell-dirstack))
  802.                ((looking-at "=\\([0-9]+\\)")
  803.                 (string-to-number
  804.                  (buffer-substring
  805.                   (match-beginning 1) (match-end 1)))))))
  806.       (cond ((null index)
  807.          nil)
  808.         ((>= index (length stack))
  809.          (error "Directory stack not that deep."))
  810.         (t
  811.          (replace-match (file-name-as-directory (nth index stack)) t t)
  812.          (message "Directory item: %d" index)
  813.          t))))))
  814.  
  815. (provide 'tshell)
  816.  
  817. ;;; tshell.el ends here
  818.